home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mission 3
/
Mission 3.zip
/
Mission 3.iso
/
spiele
/
solit
/
solit.gfa
(
.txt
)
next >
Wrap
GFA-BASIC Atari
|
1996-09-18
|
8KB
|
321 lines
' #############################################################################
' # æ M O T E L S O F T æ #
' #############################################################################
'
' -----------------------------------------------------------------------------
' Arbeitstitel > S O L I T <
' -----------------------------------------------------------------------------
' CO.HARALD BREITMAIER MARKUSPLATZ 3 7000 STUTTGART 1
' TEL. 0711~640 22 87
' #############################################################################
' ----------> DATUM <------------ ---------->VERSION 1.0 <---------
SETTIME "","02.07.88"
' #############################################################################
ON ERROR GOSUB gfa1
ON BREAK CONT
SETCOLOR 0,0
SETCOLOR 15,7,7,7
'
'
'
DIM feld%(10,10)
DIM bil$(6)
' -------------------------
GOSUB bilo("TITEL")
BMOVE V:screen$,XBIOS(3),32000
' -------------------------
GOSUB bilo("SOLIT1")
' -------------------------
REPEAT
UNTIL MOUSEK
'
BMOVE V:screen$,XBIOS(3),32000
x%=0
y%=0
GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(2)
x%=5
y%=1
GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(3)
x%=1
y%=0
GET x%*16,y%*16,(x%*16)+16,(y%*16)+16,bil$(4)
GET 2,145,47,173,ret$
GOSUB mach_es
'
> PROCEDURE mach_es
' -----
start:
' -----
IF score%>high%
high%=score%
ENDIF
'
score%=0
GOSUB feld
ox%=190
oy%=0
alle%=0
' -----
DO
' -----
rein1:
r%=1
GOSUB maus(16,16,0,10,0,10)
sx%=x%
sy%=y%
was%=feld%(sx%,sy%)
' -----
EXIT IF was%=3 OR was%=4
' -----
IF was%<>2
GOTO rein1
ENDIF
COLOR 1
GET sx%*16,sy%*16,(sx%*16)+16,(sy%*16)+16,bil$(1)
BOX sx%*16,sy%*16,(sx%*16)+16,(sy%*16)+16
ssx%=sx%*16
ssy%=sy%*16
' -------------------------
rein2:
r%=2
GOSUB maus(16,16,0,10,0,10)
nx%=x%
ny%=y%
' -----
IF k%=2
PUT ssx%,ssy%,bil$(3)
GOTO rein1
ENDIF
' -----
was%=feld%(nx%,ny%)
EXIT IF was%=3 OR was%=4
' -----
IF was%<>0
GOSUB sou3
GOTO rein2
ENDIF
' -----
IF ny%=sy%-1 OR ny%=sy%+1
GOSUB sou3
GOTO rein2
ENDIF
' -----
IF nx%=sx%-1 OR nx%=sx%+1
GOSUB sou3
GOTO rein2
ENDIF
' -----
IF ny%<sy%-2 OR ny%>sy%+2
GOSUB sou3
GOTO rein2
ENDIF
IF nx%>sx%+2 OR nx%<sx%-2
GOSUB sou3
GOTO rein2
ENDIF
' --------------------------------------------------------
IF ny%=sy% AND nx%=sx%-2
what%=feld%(sx%-1,ny%)
wegx%=sx%-1
wegy%=sy%
GOTO weiter
ENDIF
' -----
IF ny%=sy% AND nx%=sx%+2
what%=feld%(sx%+1,ny%)
wegx%=sx%+1
wegy%=sy%
GOTO weiter
ENDIF
' -----
IF nx%=sx% AND ny%=sy%-2
what%=feld%(sx%,ny%+1)
wegx%=sx%
wegy%=sy%-1
GOTO weiter
ENDIF
' -----
IF nx%=sx% AND ny%=sy%+2
what%=feld%(sx%,ny%-1)
wegx%=sx%
wegy%=sy%+1
GOTO weiter
ENDIF
GOTO rein2
weiter:
' PRINT AT(1,1);sx%;" ";wegx%;" ";nx%;"<>";sy%;" ";wegy%;" ";ny%;" "
' PRINT AT(1,3);what%;" "
' -------------------------
IF what%<>2 !KEIN STEIN DAZWISCHEN
GOSUB sou3
GOTO rein2
ENDIF
' -----
PUT wegx%*16,wegy%*16,bil$(2)
PUT sx%*16,sy%*16,bil$(2)
PUT nx%*16,ny%*16,bil$(3)
feld%(wegx%,wegy%)=0
feld%(sx%,sy%)=0
feld%(nx%,ny%)=2
INC alle%
PUT ox%,oy%,bil$(3)
ADD ox%,16
IF ox%>=318
ox%=190
ADD oy%,16
ENDIF
GOSUB sou2
LOOP
' -------------------------
PUT 232,135,ret$
tot%=8
FOR i%=0 TO 10
FOR ii%=0 TO 10
q1%=feld%(i%,ii%)
' -----
IF q1%=0
PUT i%*16,ii%*16,bil$(4)
GOSUB sou2
INC tot%
toty%=tot% DIV 8
ADD score%,10*toty%
IF high%<score%
high%=score%
ENDIF
PRINT AT(28,23);score%;"<>";high%
ENDIF
' -----
NEXT ii%
NEXT i%
PAUSE 20
REPEAT
UNTIL MOUSEK
BMOVE V:screen$,XBIOS(3),32000
GOTO start
'
RETURN
' --------------------------
> PROCEDURE maus(sc1%,sc2%,sc3%,sc4%,sc5%,sc6%)
' teiler x, teiler y,bereich <x >x bereich <y >y
'
PAUSE 20
SHOWM
'
mausin:
REPEAT
MOUSE x%,y%,k%
x%=x% DIV sc1%
y%=y% DIV sc2%
'
' PRINT AT(1,3);x%;" ";y%;" ";
' IF x%<11 AND y%<11
' PRINT AT(1,2);feld%(x%,y%);" ";r%;" "
' ENDIF
'
UNTIL k%
IF x%<sc3% OR x%>sc4%
GOTO mausin
ENDIF
IF y%<sc5% OR y%>sc6%
GOTO mausin
ENDIF
'
mausex:
'
RETURN
' -------------------------
> PROCEDURE feld
RESTORE feld
FOR i%=0 TO 10
FOR ii%=0 TO 10
READ was%
feld%(ii%,i%)=was%
NEXT ii%
NEXT i%
'
feld:
DATA 1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,2,2,2,1,1,1,1
DATA 1,1,1,1,2,2,2,1,1,1,1
DATA 1,1,1,1,2,2,2,1,1,1,1
DATA 1,2,2,2,2,2,2,2,2,2,1
DATA 1,2,2,2,2,0,2,2,2,2,1
DATA 1,2,2,2,2,2,2,2,2,2,1
DATA 1,1,1,1,2,2,2,1,1,1,1
DATA 1,1,1,1,2,2,2,1,1,1,1
DATA 3,3,3,1,2,2,2,1,4,4,4
DATA 3,3,3,1,1,1,1,1,4,4,4
RETURN
' -------------------------
> PROCEDURE bilo(fil$) !Degasbild laden
screen$=SPACE$(32000)
CLOSE #1
OPEN "i",#1,"A:\SOLIT\ART\"+fil$+".PI1"
farb$=SPACE$(34) !originalfarben des bildes laden
BGET #1,VARPTR(farb$),34 !und in string farb$ ablegen
' Z%=0
FOR i%=3 TO LEN(farb$) STEP 2 !jeweils 2 werte ergeben die farbe
farb1$=MID$(farb$,i%) !wert 1
farb2$=MID$(farb$,i%+1) !wert 2
a%=ASC(farb1$) !ascii code
b%=ASC(farb2$) !asci code
c%=a%*256+b% !wandeln in farbcode
SETCOLOR z%,c% !in die farbregister damit
INC z% !hilfszahler
NEXT i%
BGET #1,V:screen$,32000 !bild laden
CLOSE #1
RETURN
' -------------------------
> PROCEDURE sou1
SOUND 1,15,4,6
PAUSE 10
SOUND 1,0,0,0,0
RETURN
' -------------------------
> PROCEDURE sou2
FOR t%=15 DOWNTO 0
SOUND 1,t%,5,1
SOUND 2,t%,12,2
SOUND 3,t%,5,4
WAVE 7
FOR d%=0 TO 1000
NEXT d%
SOUND 3,t%,5,5
FOR d%=0 TO 1000
NEXT d%
NEXT t%
RETURN
' -------------------------
> PROCEDURE sou3
SOUND 1,15,2,3
PAUSE 10
SOUND 1,0,0,0,0
RETURN
' -------------------------
> PROCEDURE gfa1
scheisse:
GOTO scheisse
'
SETCOLOR 0,7,7,7
SETCOLOR 15,0
CLS
PRINT AT(1,1);"EIN FEHLER IST AUFGETRETEN"
PRINT AT(1,2);ERR$(ERR)
'
VOID INP(2)
EDIT
RETURN
' ----------------------
> PROCEDURE gfa2
SETCOLOR 0,7,7,7
SETCOLOR 15,0
CLS
PRINT AT(1,1);"STOP DURCH BREAK"
PRINT "FREE BYTES ";FRE(9)
'
VOID INP(2)
EDIT
RETURN
' ----------------------